DR1='N:'
DR='N:'
F1='DRUGS'
F11='DrugNM'
F7='DISPOS'
F71='DISPNM'
SELE 1
SET EXCLU OFF
USE &DR&F1 INDEX &DR&F1
SELE 7
SET EXCLU OFF
USE &DR&F7 INDEX &DR&F7
F2='DLV_PHAR'
SELE 2
SET EXCLU OFF
USE &DR&F2
SELE 1
CLEA
DO WHILE .T.
   DO WHILE .T.
      DO ADDRESSA
      @  7,  5  SAY "F. DELIVERY TO CLIENTS              D.O. NUMBER :"
      @ 9,  5  SAY "CLIENT :"
      @ 12,  6  SAY "ITEM CODE :"
      @  7, 55  SAY DONUM
      @ 9, 14  SAY COMPNAME
      @ 9, 71  SAY COMPCOD
      @  8,  3  TO 10, 76    DOUBLE
      @ 11,  4  TO 13, 24    DOUBLE
      @ 11,  1 CLEAR TO 23, 78
      CNT=0
      KODE=SPACE(4)
      kunci=space(5)
      do boxe with 11,3,'Enter Initial of Key Name : ','KUNCI','N','BG','W+','N',5,.T.,.T.
      if lastkey()=27
         set colo to bg+/b,w+/n
         RETURN
      endif
      DO GETPHAR
      IF LASTKEY()=27 .OR. CNT=0
         RETURN
      ENDIF
      SELE 1
      SET EXCLU OFF
      USE &dr1&F1 INDEX &dr1&F1
      SEEK KODE
      IF EOF()
         SELE 7
         SET EXCLU OFF
         USE &dr1&F7 INDEX &dr1&F7
         SEEK KODE
         IF EOF()
            PL3=0
            DO BOX2 WITH 8,3,'NO ITEM WITH THIS CODE NUMBER ... DO YOU WANT TO :','RETRY','CANCEL','GR+','R','W+','N',PL3,.T.,.T.
            IF PL3=2 .OR. LASTKEY()=27
               RETURN
            ENDIF
            LOOP
         ELSE
            PL11=2
         ENDIF
      ELSE
         PL11=1
      ENDIF
      IF PL11=1
         NAME = DRUG_NAME
         TYPE = DRUG_TYPE
         QANT = DRUG_QANT
         UNIT = DRUG_UNIT
         BUYUNIT = BUY_UNIT
         SELLUNIT = SELL_UNIT
         STACTBUY=ST_ACT_BUY
         STACTTOT=ST_ACT_TOT
         STACTSEL=ST_ACT_SEL
         BUYSELLR=BUY_SELL_R
         TRANSPRIC=TRANS_PRIC
      ELSE
         NAME = DISP_NAME
         TYPE = DISP_TYPE
         QANT = DISP_QANT
         UNIT = DISP_UNIT
         BUYUNIT = BUY_UNIT
         SELLUNIT = SELL_UNIT
         STACTBUY=ST_ACT_BUY
         STACTTOT=ST_ACT_TOT
         STACTSEL=ST_ACT_SEL
         BUYSELLR=BUY_SELL_R
         TRANSPRIC=TRANS_PRIC
      ENDIF
      SET COLO TO BG+/B,W+/N
      @ 11,  1 CLEAR TO 23,78
      @ 14,  5  SAY "KODE :"
      @ 14, 12  SAY KODE
      @ 14,  5  SAY "NAME :"
      @ 14, 12  SAY NAME
      @ 14, 33  SAY "TYPE :"
      @ 14, 40  SAY TYPE
      @ 14, 51  SAY "CONTENT :"
      @ 14, 61  SAY QANT
      @ 14, 69  SAY UNIT
      @ 15,  5  SAY "BUYING UNIT :"
      @ 15, 19 SAY BUYUNIT
      @ 15, 30  SAY "(MAXIMUM AVAILABLE :"
      @ 15, 62  SAY BUYUNIT
      @ 15, 75  SAY ")"
      @ 15, 52  SAY STACTBUY
      IF BUYSELLR<>1 .AND. STACTSEL>0
         @ 16, 4 SAY "SELLING UNIT :"
         @ 16, 19 SAY SELLUNIT
         @ 16, 44 SAY "(AND :"
         @ 16, 52  SAY STACTSEL
         @ 16, 62  SAY SELLUNIT
         @ 16, 75  SAY ")"
      ENDIF
      @ 22,  5  SAY "Confirm -->> Enter     Cancel -->> F4"
      @ 21,  3  TO 23, 43
      STORE 0 TO MX
      DO WHILE MX=0
         MX=INKEY()
      ENDDO
      IF MX<>13
         @ 13,3 CLEAR TO 16, 76
         @ 17,2 CLEAR TO 23, 78
         LOOP
      ELSE
         IF STACTTOT>0
            IF BUYSELLR>1
               PL3=0
               IF STACTBUY>0
                  @ 18, 5 SAY "ORDER OF COMPLETE"
                  @ 18, 23 PROMPT BUYUNIT
                  @ 18, 36 SAY "OR OF"
                  @ 18, 42 PROMPT SELLUNIT
                  MENU TO PL3
                  DO CASE
                     CASE PL3=1
                        SUNIT=BUYUNIT
                     CASE PL3=2
                        SUNIT=SELLUNIT
                  ENDCASE
               ELSE
                  SUNIT=SELLUNIT
               ENDIF
            ELSE
               SUNIT=BUYUNIT
            ENDIF
            OKK='Y'
            OKKAY='Y'
            DO WHILE OKK='Y'
               REQ = 0
               @ 18,  3 CLEAR TO 23, 78
               @ 18,  5 SAY "QUANTITY ORDERED :"
               @ 18, 31 SAY SUNIT
               @ 17, 3 TO 19, 46
               @ 18, 24 GET REQ PICT "99,999"
               READ
               MAX=IIF(SUNIT=BUYUNIT,STACTBUY,STACTTOT)
               DO WHILE REQ > MAX
                  @ 17, 2 CLEAR TO 20, 78
                  @ 18, 6 SAY "REQUESTED DELIVERY CANNOT BE PROCESSED DUE TO UNSUFFICIENT INVENTORY"
                  @ 19, 6 SAY "DELIVER MAXIMUM AVAILABLE Y/N :"
                  @ 17, 4 TO 20, 75
                  PILIH='Y'
                  DO TANYA WITH 19,38,'YN',PILIH
                  @ 17, 1  CLEA TO 23, 78
                  IF PILIH='N'
                     REQ = 0
                     @ 17, 2 TO 19,77    DOUBLE
                     @ 18, 4  SAY "ENTER QUANTITY TO BE DELIVERED :"
                     @ 18, 44  SAY  SUNIT
                     @ 18, 38  GET REQ PICT '9,999'
                     READ
                     LOOP
                  ELSE
                     REQ=MAX
                     EXIT
                  ENDIF
               ENDDO
               @ 17, 3 CLEA TO 19,76
               @ 17, 3 TO 19,46
               @ 18, 5 SAY "DELIVERY OF :"
               @ 18,19 SAY REQ PICT '9,999'
               @ 18,25 SAY SUNIT
               IF BUYSELLR<>1 .AND. SUNIT=BUYUNIT
                  SREQ=REQ*BUYSELLR
                  @ 18,39 SAY SREQ PICT '9,999'
                  @ 18,45 SAY SELLUNIT
               ENDIF
               @ 20, 3 CLEA TO 23,38
               @ 21, 5  SAY "UNIT TRANSFER PRICE :"
               @ 22, 5  SAY "COST TO BE INVOICED :"
               @ 21, 29 SAY TRANSPRIC PICT '999,999'
               @ 20, 3  TO 23, 38 DOUBLE
               IF SUNIT=BUY_UNIT
                  TOTCOST=REQ*BUYSELLR*TRANSPRIC
               ELSE
                  TOTCOST=REQ*TRANSPRIC
               ENDIF
               @ 22, 27 SAY TOTCOST PICT '9,999,999'
*               TOTL=TOTL+TOTCOST
               @ 21,40 TO 23,78
               @ 22,42 SAY "Confirm -->> Enter   Cancel -->> F4"
               DO WHILE .T.
                  STORE 0 TO MX
                  DO WHILE MX=0
                     MX=INKEY()
                  ENDDO
                  DO CASE
                     CASE MX=13
                        OKK='N'
                        OKKAY='N'
                        @ 21,40 CLEA TO 23,78
                        EXIT
                     CASE MX=-3
                        @ 16, 1 CLEA TO 23,78
*                        TOTL=TOTL-TOTCOST
                        OKK='Y'
                        OKKAY='Y'
                        EXIT
                     OTHER
                        LOOP
                  ENDCASE
                  LOOP
               ENDDO
            ENDDO
            IF PL11=1
               SELE 1
               IF REC_LOCK(0)
                  IF SUNIT=BUYUNIT
                     REPL ST_ALLOCAT WITH ST_ALLOCAT+(REQ*BUYSELLR)
                  ELSE
                     REPL ST_ALLOCAT WITH ST_ALLOCAT+REQ
                  ENDIF
               ENDIF
               UNLOCK
            ELSE
               SELE 7
               IF REC_LOCK(0)
                  IF SUNIT=BUYUNIT
                     REPL ST_ALLOCAT WITH ST_ALLOCAT+(REQ*BUYSELLR)
                  ELSE
                     REPL ST_ALLOCAT WITH ST_ALLOCAT+REQ
                  ENDIF
               ENDIF
               UNLOCK
            ENDIF

            SELE 2
            IF FIL_LOCK(0)
               APPEND BLANK
            ENDIF
            IF REC_LOCK(0)
               REPL CLIENT WITH COMPNAME
               REPL COMP_CODE WITH COMPCOD
               REPL PHAR_CODE  WITH KODE
               REPL TRANS_PRIC WITH TRANSPRIC
               REPL DATE_DELV   WITH DATE()
               IF SUNIT=BUYUNIT
                  REPL QANT_DELV   WITH REQ*BUYSELLR
               ELSE
                  REPL QANT_DELV WITH REQ
               ENDIF
               REPL DLV_UNIT WITH SELLUNIT
               REPL VAL_DELV   WITH TOTCOST
               REPL DELV_ORDER WITH DONUM
               REPL PHAR_NAME WITH NAME
               REPL PHAR_TYPE WITH TYPE
               REPL PHAR_QANT WITH QANT
               REPL PHAR_UNIT WITH SELLUNIT
               REPL DELV_PRINT WITH .F.
               REPL PO_NUMB_CL WITH PONUM
               REPL DATA_AREA WITH '1'
            ENDIF
            UNLOCK
            @ 21, 45  TO 23, 68
            @ 22, 47  SAY "OTHER ITEM (Y/N) :"
            PILIH='N'
            DO TANYA WITH 22,66,'YN',PILIH
            IF PILIH='N'
               CLOSE DATA
               CLOSE INDEX
               RETURN
            ELSE
               @ 13,3 CLEAR TO 23,78
               SELE 1
               LOOP
            ENDIF
            EXIT
         ELSE
            @ 13, 3 CLEAR TO 18, 76
            @ 11, 4 TO 13, 24 DOUBLE
            @ 15, 6 SAY "REQUESTED TRANSFER CANNOT BE PROCESSED DUE TO UNSUFFICIENT INVENTORY"
            @ 14, 3 TO 16, 76
            @ 17, 6  SAY ">>>>>>>>>> TYPE ANY KEY <<<<<<<<<<"
            @ 21, 3 CLEAR TO 23, 43
            SET CONS OFF
            WAIT ' '
            SET CONS ON
            @ 14, 3 CLEAR TO 18, 76
            LOOP
         ENDIF
      ENDIF
   ENDDO
ENDDO

